home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / door / twview93.zip / EDITBASE.INC < prev    next >
Text File  |  1992-03-11  |  3KB  |  143 lines
  1. procedure MakePort;
  2. var
  3.   s : SectorIndex;
  4.   pt : integer;
  5. begin
  6.   write('Make a port out of which ');
  7.   s := GetSector;
  8.   if s <> 0 then
  9.     if space.sectors[ s ].portType <> NotAPort then
  10.       writeln( s, ' is already a port!')
  11.     else
  12.       space.sectors[s].portType := GetPortType;
  13.  
  14. end;
  15.  
  16. procedure KillPort;
  17. var
  18.   s : SectorIndex;
  19.   p1 : portIndex;
  20. begin
  21.   write('Remove Record for Port in which ');
  22.   s := GetSector;
  23.   if s <> 0 then
  24.     if space.sectors[s].PortType = NotAPort then
  25.       writeln( 'I have no record of ', s, ' being a port.')
  26.     else
  27.       begin
  28.         space.sectors[s].portType := NotAPort;
  29.         p1 := portNumber( s );
  30.         space.ports.data[ p1 ] := space.ports.data[ space.ports.top ];
  31.         space.ports.top := space.ports.top - 1;
  32.       end;
  33. end;
  34.  
  35. procedure SetDock;
  36. var
  37.   sd : SectorIndex;
  38. begin
  39.   if space.dock = 0 then
  40.     writeln('Space Dock location is not known')
  41.   else
  42.     writeln('Current space dock in sector ', space.dock );
  43.   write('Put Space Dock in which ');
  44.   sd := GetSector;
  45.   if sd = 0 then
  46.     if not prompt('Make stardock location unknown?') then
  47.       exit;
  48.   space.dock := sd;
  49.   if sd <> 0 then
  50.     with space.sectors[ sd ] do
  51.       etc := etc or StarDock;
  52. end;
  53.  
  54. procedure Unexplore;
  55. var
  56.   us : sectorIndex;
  57. begin
  58.   write('Mark as Unexplored Which ');
  59.   us := GetSector;
  60.   if us <> 0 then
  61.     if space.sectors[ us ].number = Unexplored then
  62.       writeln( 'Sector ', us, ' is already marked as unexplored.')
  63.     else
  64.       begin
  65.         writeln('Marking ', us, ' as unexplored.');
  66.         space.sectors[ us ].number := Unexplored;
  67.       end; {if else}
  68. end; {unexplore}
  69.  
  70. procedure AvoidSector;
  71. var
  72.   us : sectorIndex;
  73. begin
  74.   write('Toggle avoid state on which? ');
  75.   us := GetSector;
  76.   if us <> 0 then
  77.     with space.sectors[ us ] do
  78.       if (etc and avoid) = Nothing  then
  79.         begin
  80.           etc := etc or avoid;
  81.           writeln('Sector ', us, ' marked as avoided.');
  82.         end
  83.       else
  84.         begin
  85.           etc := etc and (not avoid);
  86.           writeln('Sector ', us, ' marked as accessible.');
  87.         end;
  88. end; {unexplore}
  89.  
  90. procedure ClearAvoids;
  91. var
  92.   i : sector;
  93. begin
  94.   for i := 1 to MaxSector do
  95.     space.sectors[i].etc := space.sectors[i].etc and (not avoid);
  96.   writeln('All avoids cleared.');
  97. end;
  98.  
  99. procedure ListAvoids;
  100. var
  101.   i : sector;
  102. begin
  103.   writeln('Sectors marked to be avoided:');
  104.   for i := 1 to MaxSector do
  105.     if (space.sectors[i].etc and avoid) <> Nothing then
  106.       write( i : 5 );
  107.   writeln;
  108. end;
  109.  
  110.  
  111. procedure EditMenu;
  112. { choices for direct editing the data base }
  113. var
  114.   ch : char;
  115. begin
  116.   repeat
  117.     repeat
  118.       writeln('Declare a sector to be a <P>ort');
  119.       writeln('Declare a sector <N>OT to be a port');
  120.       writeln('Define location of Star <D>ock');
  121.       writeln('Make sector <U>nexplored');
  122.       writeln('Toggle sector a<V>oidance');
  123.       writeln('<L>ist avoided sectors');
  124.       writeln('<C>lear all avoids');
  125.       writeln;
  126.       writeln('<Q>uit');
  127.       writeln;
  128.       write('Your choice? ');
  129.       readln( ch );
  130.       ch := upcase( ch );
  131.     until ch in ['P', 'N', 'D', 'U', 'V', 'C', 'L', 'Q'];
  132.     case ch of
  133.       'P' : Makeport;
  134.       'N' : Killport;
  135.       'D' : setDock;
  136.       'U' : unexplore;
  137.       'V' : avoidSector;
  138.       'C' : clearAvoids;
  139.       'L' : listAvoids;
  140.       'Q' : ;
  141.     end; {case}
  142.   until ch = 'Q';
  143. end; {Edit Menu}